home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / SUNForm.st < prev    next >
Text File  |  1993-07-24  |  8KB  |  234 lines
  1. "    NAME        SUNForm
  2.     AUTHOR        CWatts@BNR.CA (Carl Watts)
  3.     FUNCTION    additions to Form for SUN Raster and Icon format
  4.     ST-VERSION    
  5.     PREREQUISITES    
  6.     CONFLICTS    
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE     16 May 1991
  10. SUMMARY
  11. Here's some nice additions to class Form in Smalltalk-80.  There are
  12. methods to convert a file in Sun Raster File format and Sun Icon Edit
  13. Format into a Form.
  14. "!
  15. "
  16. From: CWatts@BNR.CA (Carl Watts)
  17. Newsgroups: comp.lang.smalltalk
  18. Subject: Some nice additions to Form in Smalltalk-80
  19. Message-ID: <1991May16.184243.11662@bqnes74.bnr.ca>
  20. Date: Thu, 16 May 91 19:42:43 BST
  21.  
  22. Here's some nice additions to class Form in Smalltalk-80.  There are
  23. methods to convert a file in Sun Raster File format and Sun Icon Edit
  24. Format into a Form.  All these methods were either written by me or
  25. rewritten by me to make them faster.  There is even a new Form
  26. class>readFrom: method that trys to recognize what format a file is
  27. and convert it into a form appropriately if it can.  This method
  28. should be modified to include recognition of any other foreign bitmap
  29. file format that Form has method [this part lost .. Ed]
  30. onvert.
  31.  
  32. Theres also a couple of simple image processing methods for instances
  33. of form.  One quickly finds the smallest Rectangle which bounds all
  34. the black pixels on a Form.  Like what happens when you hold down the
  35. command key when you use the selection box tool in MacPaint.  Another
  36. 'hollowed' answers a new form with all the solid black areas of the
  37. receiving form hollowed out.  Kind of simple (but fast) edge
  38. detection.  Kind of like 'Trace edges' in MacPaint.  Anyway, here's
  39. the fileIn:
  40. "
  41.  
  42. !Form methodsFor: 'display box access'!
  43.  
  44. minimumBoundingBox
  45.  
  46. "Compute and answer the smallest rectangle that encloses the black area of the form."
  47.  
  48. "| form |
  49.  [Sensor redButtonPressed] whileFalse: [
  50.     form _ Form fromDisplay: (Rectangle center: Sensor cursorPoint extent: 128@128).
  51.     form border: form minimumBoundingBox width: 1.
  52.     form display]."
  53.  
  54.     | smushForm result scanY clippingBox scanX |
  55.  
  56.     result _ self boundingBox.
  57.  
  58.     smushForm _ Form extent: self extent.
  59.  
  60.     self displayOn: smushForm at: self offset negated.
  61.     scanY _ 2 raisedToInteger: (smushForm height floorLog: 2).
  62.     clippingBox _ smushForm boundingBox.
  63.     [scanY > 0] whileTrue: [
  64.         clippingBox bottom: scanY.
  65.         smushForm displayOn: smushForm at: 0@scanY negated clippingBox: clippingBox rule: Form under mask: Form black.
  66.         scanY _ scanY // 2].
  67.  
  68.     scanX _ clippingBox left.
  69.     [scanX < clippingBox right and: [(smushForm valueAt: scanX@0) = 0]]
  70.         whileTrue: [scanX _ scanX + 1].
  71.     result left: scanX.
  72.  
  73.     scanX _ clippingBox right - 1.
  74.     [scanX >= clippingBox left and: [(smushForm valueAt: scanX@0) = 0]]
  75.         whileTrue: [scanX _ scanX - 1].
  76.     result right: (scanX + 1 max: result left).
  77.  
  78.     self displayOn: smushForm at: self offset negated.
  79.     scanX _ 2 raisedToInteger: (smushForm width floorLog: 2).
  80.     clippingBox _ smushForm boundingBox.
  81.     [scanX > 0] whileTrue: [
  82.         clippingBox right: scanX.
  83.         smushForm displayOn: smushForm at: scanX negated@0 clippingBox: clippingBox rule: Form under mask: Form black.
  84.         scanX _ scanX // 2].
  85.  
  86.     scanY _ clippingBox top.
  87.     [scanY < clippingBox bottom and: [(smushForm valueAt: 0@scanY) = 0]]
  88.         whileTrue: [scanY _ scanY + 1].
  89.     result top: scanY.
  90.  
  91.     scanY _ clippingBox bottom - 1.
  92.     [scanY >= clippingBox top and: [(smushForm valueAt: 0@scanY) = 0]]
  93.         whileTrue: [scanY _ scanY - 1].
  94.     result bottom: (scanY + 1 max: result top).
  95.  
  96.     ^result! !
  97.  
  98. !Form methodsFor: 'image manipulation'!
  99.  
  100. hollowed
  101.  
  102. "Answer a form with the image of the receiver hollowed out."
  103.  
  104.     | smearForm finalForm stampForm |
  105.  
  106.     stampForm _ Form extent: self extent + (2@2).
  107.     self displayOn: stampForm at: self offset negated + (1@1).
  108.     smearForm _ (Form extent: stampForm extent) black.
  109.     -1 to: 1 do: [:dx |
  110.         -1 to: 1 do: [:dy |
  111.             stampForm displayOn: smearForm at: dx@dy rule: Form and]].
  112.     smearForm _ smearForm reverse.
  113.     stampForm displayOn: smearForm rule: Form and.
  114.     finalForm _ Form new extent: self extent offset: self offset.
  115.     smearForm displayOn: finalForm at: -1@-1.
  116.     ^finalForm
  117.  
  118.     "[Sensor redButtonPressed] whileFalse: [
  119.         ((Form fromDisplay: (Rectangle center: Sensor cursorPoint extent: 128@128)) hollowed) display]."!
  120.  
  121. smeared
  122.  
  123. "Answer a form with the image of the receiver smeared."
  124.  
  125.     | smearForm |
  126.  
  127.     smearForm _ Form new extent: self extent + (2@2) offset: self offset - (1@1).
  128.     0 to: 2 do: [:dx |
  129.         0 to: 2 do: [:dy |
  130.             self displayOn: smearForm at: self offset negated + (dx@dy) rule: Form under]].
  131.     ^smearForm
  132.  
  133.     "[Sensor redButtonPressed] whileFalse:
  134.         [((Form fromDisplay: (Rectangle new origin: Sensor cursorPoint extent: 128@128))
  135.             smeared)
  136.                 displayAt: 0@0]."! !
  137.  
  138. !Form class methodsFor: 'fileIn/Out'!
  139.  
  140. readFrom: fileName
  141.  
  142. "Answer an instance of the receiver with bitmap initialized from the external file named fileName.  Answer nil if the file does not contain a kind of Form."
  143.  
  144.     | file code |
  145.  
  146.     file _ fileName asFilename readStream.
  147.     [file binary.
  148.      code _ file nextWord.    "reads fileCode"
  149.      file skip: -2.
  150.      code = 1 ifTrue: [^self readFormFile: file].
  151.      code = 16r59A6 ifTrue: [^self readSunRaster: fileName].
  152.      ^self readSunIconEdit: fileName    "last chance"
  153.      ] valueNowOrOnUnwindDo: [file close]!
  154.  
  155. readSunIconEdit: fileName
  156.  
  157. "Answer an instance of the receiver with bitmap initialized from the external file named fileName (created by Sun's IconEdit).  Answer nil if the file does not contain a kind of Form."
  158. "By Carl Watts"
  159.  
  160.     | file width height form word wordNo |
  161.  
  162.     file _ fileName asFilename readStream.
  163.     [(file skipToAll: 'idth') isNil ifTrue: [^nil].
  164.      file skip: 5; skipSeparators.
  165.      (width _ Integer readFrom: file) <= 0 ifTrue: [^nil].
  166.  
  167.      (file skipToAll: 'eight') isNil ifTrue: [^nil].
  168.      file skip: 6; skipSeparators.
  169.      (height _ Integer readFrom: file) <= 0 ifTrue: [^nil].
  170.  
  171.      form _ self new extent: width@height.
  172.  
  173.      wordNo _ 0.
  174.      1 to: height do: [:row |
  175.         1 to: (width + 15 // 16) do: [:col |   "rows are rounded up to next multiple of 8 bits"
  176.             (file skipToAll: '0x') isNil ifTrue: [^nil]. file skip: 2.
  177.             word _ Integer readFrom: file radix: 16.
  178.             form bitsWordAt: (wordNo _ wordNo + 1) put: word]]]
  179.         valueNowOrOnUnwindDo: [file close].
  180.  
  181.     ^form!
  182.  
  183. readFormFile: file
  184.  
  185. "Answer an instance of the receiver with bitmap initialized from the external file."
  186. "The file format is:  fileCode(1), extent, offset, bits."
  187.  
  188.     | form width height offsetX offsetY |
  189.  
  190.     [file binary.
  191.      file nextWord = 1 ifFalse: [^self error: 'Not a Form file'].    "reads fileCode"
  192.      width _ file nextWord.  height _ file nextWord.
  193.      offsetX  _ file nextWord.  offsetY _ file nextWord.
  194.      offsetX > 32767 ifTrue: [offsetX _ offsetX - 65536]. "stored two's-complement"
  195.      offsetY > 32767 ifTrue: [offsetY _ offsetY - 65536]. "stored two's-complement"
  196.      form _ (self extent: width@height) offset: offsetX@offsetY.
  197.      1 to: (width + 15 // 16) * height do: [:i | form bitsWordAt: i put: file nextWord]]
  198.         valueNowOrOnUnwindDo: [file close].
  199.      ^form!
  200.  
  201. readSunRaster: aFilename 
  202.  
  203. "Answer an instance of me with bitmap initialized from a Sun Raster file..."
  204. "Written by Carl Watts (cwatts@BNR.CA)"
  205. "(Form readSunRaster: 'image.sun') edit"
  206.  
  207.     | file rasterType imageWords form |
  208.  
  209.     file _ aFilename asFilename readStream.
  210.     [file binary.
  211.      file nextLong = 16r59A66A95 ifFalse: [self error: 'Not a Sun Raster File'].
  212.      form _ self extent: file nextLong@file nextLong.
  213.      file nextLong = 1 ifFalse: [self error: 'Raster file is not monochrome'].
  214.      file nextLong.   "Ignore the image length since I can't rely on it anyway."
  215.      imageWords _ (form width / 16) ceiling * form height.
  216.      rasterType _ file nextLong.
  217.      (rasterType between: 0 and: 2) ifFalse: [self error: 'Unknown raster file rasterType'].
  218.      file nextLong.  "Ignore the raster maptype."
  219.      file skip: file nextLong.  "Skip the color map."
  220.      (rasterType = 2) "run length compression of bytes"
  221.         ifFalse: [1 to: imageWords do: [:i | form bitsWordAt: i put: file nextWord]]
  222.         ifTrue: [ | bits a b bitStream |
  223.             bits _ ByteArray new: imageWords * 2.
  224.             bitStream _ bits writeStream.
  225.             [(a _ file next) notNil] whileTrue: [
  226.                 (a = 128) ifFalse: [bitStream nextPut: a]
  227.                     ifTrue: [(b _ file next) = 0
  228.                         ifTrue: [bitStream nextPut: 128]
  229.                         ifFalse: [bitStream next: b+1 put: file next]]].
  230.             1 to: imageWords do: [:i | form bitsWordAt: i put: (bits wordAt: i)]]] valueNowOrOnUnwindDo: [file close].
  231.     ^form! !
  232.  
  233.  
  234.